home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / videolab / testu.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  9KB  |  345 lines
  1. unit Testu;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   VideoLab, ExtCtrls, StdCtrls, Buttons, Menus, MPlayer, Audio;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     Panel1: TPanel;
  12.     Panel2: TPanel;
  13.     DriverName: TLabel;
  14.     VideoCaptureParms: TVideoCaptureParms;
  15.     labelStatus: TLabel;
  16.     VideoAudioParms: TVideoAudioParms;
  17.     VideoLab: TVideoLab;
  18.     MainMenu: TMainMenu;
  19.     MenuFile: TMenuItem;
  20.     MenuExit: TMenuItem;
  21.     MenuSaveDIB: TMenuItem;
  22.     MenuSaveBitmap: TMenuItem;
  23.     MenuEdit: TMenuItem;
  24.     MenuEditCopy: TMenuItem;
  25.     Setup1: TMenuItem;
  26.     MenuFormat: TMenuItem;
  27.     MenuSource: TMenuItem;
  28.     MenuDisplay: TMenuItem;
  29.     MenuCompress: TMenuItem;
  30.     MenuVideo: TMenuItem;
  31.     MenuPreview: TMenuItem;
  32.     MenuOverlay: TMenuItem;
  33.     MenuPause: TMenuItem;
  34.     MenuPlayback: TMenuItem;
  35.     MenuPlay: TMenuItem;
  36.     MenuPlayOpen: TMenuItem;
  37.     MenuActive: TMenuItem;
  38.     MenuCapture: TMenuItem;
  39.     MenuOpenExternal: TMenuItem;
  40.     MenuPbClose: TMenuItem;
  41.     N3: TMenuItem;
  42.     N2: TMenuItem;
  43.     N1: TMenuItem;
  44.     N4: TMenuItem;
  45.     N5: TMenuItem;
  46.     MenuSetAudioFormat: TMenuItem;
  47.     MenuPlaySpace: TMenuItem;
  48.     N6: TMenuItem;
  49.     function VideoLabError(Sender: TObject; nId: Integer;
  50.       pMsg: PChar): Longint;
  51.     function VideoLabStatus(Sender: TObject; nId: Integer;
  52.       pMsg: PChar): Longint;
  53.     function VideoLabFrame(Sender: TObject; pVideo: PVideoHdr): Longint;
  54.     procedure FormCreate(Sender: TObject);
  55.     procedure MenuSaveBitmapClick(Sender: TObject);
  56.     procedure MenuSaveDIBClick(Sender: TObject);
  57.     procedure MenuExitClick(Sender: TObject);
  58.     procedure MenuEditCopyClick(Sender: TObject);
  59.     procedure MenuFormatClick(Sender: TObject);
  60.     procedure MenuSourceClick(Sender: TObject);
  61.     procedure MenuDisplayClick(Sender: TObject);
  62.     procedure MenuCompressClick(Sender: TObject);
  63.     procedure MenuOverlayClick(Sender: TObject);
  64.     procedure MenuPreviewClick(Sender: TObject);
  65.     procedure MenuPauseClick(Sender: TObject);
  66.     procedure MenuPlayClick(Sender: TObject);
  67.     procedure MenuPlayOpenClick(Sender: TObject);
  68.     procedure MenuActiveClick(Sender: TObject);
  69.     procedure MenuCaptureClick(Sender: TObject);
  70.     procedure MenuOpenExternalClick(Sender: TObject);
  71.     procedure MenuPbCloseClick(Sender: TObject);
  72.     procedure MenuSetAudioFormatClick(Sender: TObject);
  73.     procedure MenuPlaySpaceClick(Sender: TObject);
  74.   private
  75.     nFrameCount: Integer;
  76.   private
  77.      procedure SetupMenu;
  78.   end;
  79.  
  80. var
  81.   MainForm:    TMainForm;
  82.   DriverCaps:  TVideoDriverCaps;
  83.   VideoStatus: TVideoStatus;
  84.  
  85. implementation
  86.  
  87. {$R *.DFM}
  88.  
  89. procedure TMainForm.SetupMenu;
  90. begin
  91.   { Get current status }
  92.   VideoLab.GetStatus(@VideoStatus);
  93.  
  94.   { Set menu items }
  95.   MenuActive .Checked := VideoLab.Active;
  96.   MenuPreview.Checked := VideoStatus.fLiveWindow;
  97.   MenuOverlay.Checked := VideoStatus.fOverlayWindow;
  98. end;
  99.  
  100. function TMainForm.VideoLabError(Sender: TObject; nId: Integer;
  101.   pMsg: PChar): Longint;
  102. begin
  103.   { Display error message }
  104.   MessageDlg(pMsg, mtError, [mbOK], 0);
  105.   VideoLabError := 1;
  106. end;
  107.  
  108. function TMainForm.VideoLabStatus(Sender: TObject; nId: Integer; pMsg: PChar): Longint;
  109. begin
  110.   { Show the current status }
  111.   labelStatus.Caption := pMsg;
  112.   VideoLabStatus      := 1;
  113.  
  114.   { Menu }
  115.   SetupMenu();
  116. end;
  117.  
  118. function TMainForm.VideoLabFrame(Sender: TObject; pVideo: PVideoHdr): Longint;
  119. begin
  120.   { Show that we are really doing something }
  121.   nFrameCount    := nFrameCount + 1;
  122.   labelStatus.Caption := Format('Frame: %d', [nFrameCount]);
  123.   VideoLabFrame  := 1;
  124. end;
  125.  
  126. procedure TMainForm.FormCreate(Sender: TObject);
  127. begin
  128.   { Variables }
  129.   nFrameCount := 0;
  130.  
  131.   { Reset all video windows }
  132.   VideoLab.Reset();
  133.  
  134.   { Turn on video }
  135.   MenuActiveClick(Sender);
  136. end;
  137.  
  138. procedure TMainForm.MenuSaveDIBClick(Sender: TObject);
  139. begin
  140.   { Use video driver to save current frame }
  141.   VideoLab.FileSaveDIB('\Test.Bmp');
  142. end;
  143.  
  144. procedure TMainForm.MenuSaveBitmapClick(Sender: TObject);
  145. begin
  146.   { Get current status }
  147.   VideoLab.GetStatus(@VideoStatus);
  148.  
  149.   { Live? }
  150.   if (VideoStatus.fOverlayWindow)
  151.      then MessageDlg('Video can not be in Overlay mode.', mtError, [mbOK], 0)
  152.      { Save the current frame window to file }
  153.      else VideoLab.SaveToBitmap(8, BI_RLE8, '\Test.Bmp');
  154. end;
  155.  
  156. procedure TMainForm.MenuExitClick(Sender: TObject);
  157. begin
  158.   MainForm.Close;
  159. end;
  160.  
  161. procedure TMainForm.MenuEditCopyClick(Sender: TObject);
  162. begin
  163.   { Copy frame to the clip board }
  164.   VideoLab.EditCopy();
  165. end;
  166.  
  167. procedure TMainForm.MenuFormatClick(Sender: TObject);
  168. begin
  169.   { Display dialog }
  170.   if (DriverCaps.fHasDlgVideoFormat)
  171.      then VideoLab.FormatDialog()
  172.      else MessageDlg('Not supported by video driver', mtInformation, [mbOK], 0);
  173. end;
  174.  
  175. procedure TMainForm.MenuSourceClick(Sender: TObject);
  176. begin
  177.   { Display dialog }
  178.   if (DriverCaps.fHasDlgVideoSource)
  179.      then VideoLab.SourceDialog()
  180.      else MessageDlg('Not supported by video driver', mtInformation, [mbOK], 0);
  181. end;
  182.  
  183. procedure TMainForm.MenuDisplayClick(Sender: TObject);
  184. begin
  185.   { Display dialog }
  186.   if (DriverCaps.fHasDlgVideoDisplay)
  187.      then VideoLab.DisplayDialog()
  188.      else MessageDlg('Not supported by video driver', mtInformation, [mbOK], 0);
  189. end;
  190.  
  191. procedure TMainForm.MenuCompressClick(Sender: TObject);
  192. begin
  193.   { Display dialog }
  194.   VideoLab.CompressionDialog();
  195. end;
  196.  
  197. procedure TMainForm.MenuOverlayClick(Sender: TObject);
  198. begin
  199.   { Turn on Overlay Mode }
  200.   VideoLab.Overlay := True;
  201. end;
  202.  
  203. procedure TMainForm.MenuPreviewClick(Sender: TObject);
  204. begin
  205.   { Turn on Preview Mode }
  206.   VideoLab.Preview     := True;
  207.   VideoLab.PreviewRate := 1;
  208.  
  209.   { Clear frame counter }
  210.   nFrameCount := 0;
  211. end;
  212.  
  213. procedure TMainForm.MenuPauseClick(Sender: TObject);
  214. begin
  215.   { Stop on the current frame }
  216.   VideoLab.GrabFrame(True);
  217. end;
  218.  
  219. procedure TMainForm.MenuPlayOpenClick(Sender: TObject);
  220. begin
  221.   { Load play back file }
  222.   VideoLab.PlaybackLoad(True, MCIWNDF_SHOWNAME, PAnsiChar(VideoLab.AVIFileName));
  223. end;
  224.  
  225. procedure TMainForm.MenuOpenExternalClick(Sender: TObject);
  226. begin
  227.   { Load play back file }
  228.   VideoLab.PlaybackLoad(False, MCIWNDF_SHOWNAME, PAnsiChar(VideoLab.AVIFileName));
  229. end;
  230.  
  231. procedure TMainForm.MenuPlayClick(Sender: TObject);
  232. begin
  233.   { Start play back }
  234.   VideoLab.PlaybackStart();
  235. end;
  236.  
  237. procedure TMainForm.MenuPbCloseClick(Sender: TObject);
  238. begin
  239.   { Remove playback window }
  240.   VideoLab.PlaybackUnload();
  241. end;
  242.  
  243. procedure TMainForm.MenuActiveClick(Sender: TObject);
  244. var
  245.   pTmp: array[0..80] of Char;
  246. begin
  247.   { Toggel video. }
  248.   if (VideoLab.Active)
  249.      then VideoLab.Active := False
  250.      else VideoLab.Active := True;
  251.  
  252.   { Display }
  253.   if (Not VideoLab.Active) then
  254.      DriverName.Caption := ''
  255.   else
  256.   begin
  257.      { Get driver name }
  258.      VideoLab.GetDriverName(0, pTmp, 80);
  259.      DriverName.Caption := pTmp;
  260.      VideoLab.GetDriverVersion(0, pTmp, 80);
  261.      DriverName.Caption := DriverName.Caption + ' ' + pTmp;
  262.   end;
  263.  
  264.   { Get driver caps }
  265.   VideoLab.GetDriverCaps(@DriverCaps);
  266.  
  267.   { Get current status }
  268.   VideoLab.GetStatus(@VideoStatus);
  269. end;
  270.  
  271. procedure TMainForm.MenuCaptureClick(Sender: TObject);
  272. var
  273.   lSize:   Longint;
  274.   pBmp:    PBITMAPINFOHEADER;
  275. begin
  276.   { Change the Video Format }
  277.   lSize := VideoLab.GetVideoFormatSize();
  278.   pBmp  := MemAlloc(lSize+20);
  279.   VideoLab.GetVideoFormat(pBmp, lSize);
  280.  
  281.   { Set Window size }
  282.   pBmp.biWidth      := 280;
  283.   pBmp.biHeight     := 210;
  284.   pBmp.biSizeImage  := pBmp.biWidth * pBmp.biHeight * pBmp.biPlanes * (pBmp.biBitCount div 8);
  285.  
  286.   { Save }
  287.   VideoLab.SetVideoFormat(pBmp, lSize);
  288.   FreeMem(pBmp);
  289.  
  290.   { Start capturing the video }
  291.   VideoLab.Sequence();
  292. end;
  293.  
  294. procedure TMainForm.MenuSetAudioFormatClick(Sender: TObject);
  295. var
  296.   audio:   TFormAudio;
  297. begin
  298.   audio := TFormAudio.Create(Self);
  299.  
  300.   { Sample Rate }
  301.   if (VideoAudioParms.BitsPerSample = 8)
  302.      then audio.rb8bit .Checked := True
  303.      else audio.rb16bit.Checked := True;
  304.  
  305.   { Channels }
  306.   if (VideoAudioParms